home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue61 / BHO / uInfoBHO.pas < prev    next >
Pascal/Delphi Source File  |  2000-07-07  |  7KB  |  207 lines
  1. unit uInfoBHO;
  2.  
  3. interface
  4.  
  5. uses
  6.   ComObj, ActiveX, pSimpleBHO_TLB, StdVcl, SHDocVW, Windows, SysUtils, Dialogs,
  7.   uBHOManager;
  8.  
  9. const DISPID_BEFORENAVIGATE2 = 250;
  10. const DISPID_NAVIGATECOMPLETE2 = 252;
  11.  
  12. type
  13.   TInfoBHO = class(TAutoObject, IInfoBHO, IObjectWithSite, IDispatch)
  14.   private
  15.     BHOManager : TfrmBHOManager;
  16.     function AdviseEvents : boolean;
  17.     function GetParameterTypeAsString(  varType : TVarType ) : String;
  18.  
  19.   protected
  20.     WebBrowser : IWebBrowser2;
  21.   public
  22.     procedure Initialize; override;
  23.     // Explorer releated methods.
  24.     function SetSite(const pUnkSite: IUnknown ):HResult; stdcall;
  25.     function GetSite(const riid: TIID; out site: IUnknown):HResult; stdcall;
  26.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  27.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  28.  
  29.  
  30.   end;
  31.  
  32. implementation
  33.  
  34. uses ComServ;
  35.  
  36. // Private methods for the TInfoBHO class.
  37.  
  38. function TInfoBHO.GetParameterTypeAsString(  varType : TVarType ) : String;
  39. begin
  40.    case varType of
  41.       VT_UI1:   Result := 'VT_UI1';
  42.       VT_I2:    Result := 'VT_I2';
  43.       VT_I4:    Result := 'VT_I4';
  44.       VT_R4:    Result := 'VT_R4';
  45.       VT_R8:    Result := 'VT_R8';
  46.       VT_BOOL:  Result := 'VT_BOOL';
  47.       VT_ERROR: Result := 'VT_ERROR';
  48.       VT_CY:    Result := 'VT_CY';
  49.       VT_DATE:  Result := 'VT_DATE';
  50.       VT_BSTR:  Result := 'VT_BSTR';
  51.       VT_UNKNOWN:  Result := 'VT_UNKNOWN';
  52.       VT_DISPATCH: Result := 'VT_DISPATCH';
  53.       VT_ARRAY:    Result := 'VT_ARRAY';
  54.       VT_BYREF or VT_UI1:   Result := 'VT_BYREF or VT_UI1';
  55.       VT_BYREF or VT_I2:    Result := 'VT_BYREF or VT_I2';
  56.       VT_BYREF or VT_I4:    Result := 'VT_BYREF or VT_I4';
  57.       VT_BYREF or VT_R4:    Result := 'VT_BYREF or VT_R4';
  58.       VT_BYREF or VT_R8:    Result := 'VT_BYREF or VT_R8';
  59.       VT_BYREF or VT_BOOL:  Result := 'VT_BYREF or VT_BOOL';
  60.       VT_BYREF or VT_ERROR: Result := 'VT_BYREF or VT_ERROR';
  61.       VT_BYREF or VT_CY:    Result := 'VT_BYREF or VT_CY';
  62.       VT_BYREF or VT_DATE:  Result := 'VT_BYREF or VT_DATE';
  63.       VT_BYREF or VT_BSTR:  Result := 'VT_BYREF or VT_BSTR';
  64.       VT_BYREF or VT_UNKNOWN:  Result := 'VT_BYREF or VT_UNKNOWN';
  65.       VT_BYREF or VT_DISPATCH: Result := 'VT_BYREF or VT_DISPATCH';
  66.       VT_BYREF or VT_ARRAY:    Result := 'VT_BYREF or VT_ARRAY';
  67.       VT_BYREF or VT_VARIANT:  Result := 'VT_BYREF or VT_VARIANT';
  68.       VT_BYREF: Result := 'VT_BYREF';
  69.       VT_I1:    Result := 'VT_I1';
  70.       VT_UI2:   Result := 'VT_UI2';
  71.       VT_UI4:   Result := 'VT_UI4';
  72.       VT_INT:   Result := 'VT_INT';
  73.       VT_UINT:  Result := 'VT_UINT';
  74.       VT_BYREF or VT_DECIMAL: Result := 'VT_BYREF or VT_DECIMAL';
  75.       VT_BYREF or VT_I1:      Result := 'VT_BYREF or VT_I1';
  76.       VT_BYREF or VT_UI2:     Result := 'VT_BYREF or VT_UI2';
  77.       VT_BYREF or VT_UI4:     Result := 'VT_BYREF or VT_UI4';
  78.       VT_BYREF or VT_INT:     Result := 'VT_BYREF or VT_INT';
  79.       VT_BYREF or VT_UINT:    Result := 'VT_BYREF or VT_UINT';
  80.    end;
  81.  
  82. end;
  83.  
  84. // Advise events to listen for browser events.
  85. function TInfoBHO.AdviseEvents : boolean;
  86. var
  87.   ConnectionPoints : IConnectionPointContainer;
  88.   WebEvents : IConnectionPoint;
  89.   Hr : HResult;
  90.   dwCookie : Integer;
  91. begin
  92.   ConnectionPoints := WebBrowser as IConnectionPointContainer;
  93.   Hr := ConnectionPoints.FindConnectionPoint( DIID_DWebBrowserEvents2, WebEvents );
  94.   WebEvents.Advise( self as IDispatch, dwCookie );
  95.   Result := true;
  96.  
  97. end;
  98.  
  99. // Create the BHO manager form.
  100. procedure TInfoBHO.Initialize;
  101. begin
  102.   BHOManager := TfrmBHOManager.Create( nil );
  103.   BHOManager.Show;
  104. end;
  105.  
  106. // SetSite method
  107. function TInfoBHO.SetSite(const pUnkSite: IUnknown ):HResult;
  108. begin
  109.   if ( pUnkSite <> Nil ) then
  110.   begin
  111.      WebBrowser := pUnkSite as IWebBrowser2;
  112.      AdviseEvents;
  113.   end;
  114.   Result := S_OK;
  115. end;
  116.  
  117. function TInfoBHO.GetSite(const riid: TIID; out site: IUnknown):HResult;
  118. begin
  119.   Result := S_OK;
  120.  
  121. end;
  122.  
  123. // The Invoke method - where all the fun takes place.
  124. function TInfoBHO.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  125.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
  126. var
  127.   DispParams : TDispParams;
  128.   VarArg : TVariantArg;
  129.   varType : TVarType;
  130.   WebAsVariant : PVariant;
  131.   CurrentWebBrowser : IWebBrowser2;
  132.   PostData, TargetFrame, NavigateToUrl : String;
  133. begin
  134.    try
  135.        DispParams := TDispParams(Params);
  136.        case DispID of
  137.          // [0]: Cancel flag  - VT_BYREF|VT_BOOL
  138.          // [1]: HTTP headers - VT_BYREF|VT_VARIANT
  139.          // [2]: Address of HTTP POST data  - VT_BYREF|VT_VARIANT
  140.          // [3]: Target frame name - VT_BYREF|VT_VARIANT
  141.          // [4]: Option flags - VT_BYREF|VT_VARIANT
  142.          // [5]: URL to navigate to - VT_BYREF|VT_VARIANT
  143.          // [6]: An object that evaluates to the top-level or frame
  144.          //      WebBrowser object corresponding to the event.
  145.          DISPID_BEFORENAVIGATE2 :
  146.            begin
  147.             // Get current IWebBrowser2 interface.
  148.             VarArg := DispParams.rgvarg^[6];
  149.             CurrentWebBrowser := IDispatch(VarArg.dispVal) as IWebBrowser2;
  150.  
  151.             varType := VarArg.vt;
  152.             GetParameterTypeAsString( varType );
  153.  
  154.             // Get PostData information.
  155.             VarArg := DispParams.rgvarg^[2];
  156.             PostData := VarArg.pvarVal^;
  157.             // Get Target frame name.
  158.             VarArg := DispParams.rgvarg^[3];
  159.             TargetFrame := VarArg.pvarVal^;
  160.             // Get NavigateTo url.
  161.             VarArg := DispParams.rgvarg^[5];
  162.             NavigateToUrl := VarArg.pvarVal^;
  163.             if ( Assigned( BHOManager ) ) then
  164.             begin
  165.                BHOManager.SetWebBrowser( CurrentWebBrowser );
  166.                if ( CurrentWebBrowser = WebBrowser ) then
  167.                   BHOManager.AddLogLine( 'BeforeNavigate2 - TopWindow' )
  168.                else
  169.                   BHOManager.AddLogLine( 'BeforeNavigate2 - FrameWindow' );
  170.             end;
  171.  
  172.            end;
  173.          // [0]: URL navigated to - VT_BYREF|VT_VARIANT
  174.      // [1]: An object that evaluates to the top-level or frame
  175.      //      WebBrowser object corresponding to the event.
  176.          DISPID_NAVIGATECOMPLETE2 :
  177.            begin
  178.             // Get current IWebBrowser2 interface.
  179.             VarArg := DispParams.rgvarg^[1];
  180.             CurrentWebBrowser := IDispatch(VarArg.dispVal) as IWebBrowser2;
  181.  
  182.             // Get URL navigated to.
  183.             VarArg := DispParams.rgvarg^[0];
  184.             NavigateToUrl := VarArg.pvarVal^;
  185.             if ( Assigned( BHOManager ) ) then
  186.             begin
  187.                if ( CurrentWebBrowser = WebBrowser ) then
  188.                   BHOManager.AddLogLine( 'NavigateComplete2 - TopWindow' )
  189.                else
  190.                   BHOManager.AddLogLine( 'NavigateComplete2 - FrameWindow' );
  191.             end;
  192.            end;
  193.  
  194.        end;
  195.    finally
  196.      Result := S_OK;
  197.    end;
  198. end;
  199.  
  200.  
  201.  
  202. initialization
  203.   TAutoObjectFactory.Create(ComServer, TInfoBHO, Class_InfoBHO,
  204.     ciMultiInstance, tmApartment);
  205.  
  206. end.
  207.